Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/1159.ZIP/OSSMODMF.PRG

Text File | 1987-01-27 | 28KB | 1,176 lines

DUP100=0
IF MULTTV=0.AND.MULTSN=0
CLOSE DATABASES
USE &DBNAME INDEX &INDEX1,&INDEX2
ENDIF
SET SAFETY OFF
DAT=DATE()
N7=0
PUBLIC CALOVER
CALOVER=0
SET DELETED ON
DO CASE
 CASE MULTTV=1
  CLOSE DATABASES
  SELECT 2
  USE REPWORK
  SELECT 1
  USE &DBNAME INDEX &INDEX1,&INDEX2
  SEEK TVANO
IF EOF()
 CLEAR
 @ 1,20 SAY 'Data base in use:  '
 ?? OSS
 @ 5,0 SAY 'No record was found in which "'
 ?? TVANO
 ??'" exactly '
 ?'matched any item in the '
 ?? TVANUMBER
 ??' field.'
 ?
 ?
 ?
 WAIT
 RETURN
ENDIF
  DO WHILE TVANO=TVA_NO
   SELECT 2
   APPEND BLANK
   REPLACE SUBCATID WITH A->SUBCATID
   REPLACE INST_TYPE WITH A->INST_TYPE
   REPLACE TVA_NO WITH A->TVA_NO
   REPLACE SERIAL_NO WITH A->SERIAL_NO
   REPLACE BY_DATE WITH A->BY_DATE
   REPLACE CALIB_DATE WITH A->CALIB_DATE
   REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
   REPLACE LOCATION WITH A->LOCATION
   REPLACE REMARK WITH A->REMARK
   REPLACE CALIB_INT WITH A->CALIB_INT
   REPLACE LAST_UPDAT WITH A->LAST_UPDAT
   SELECT 1
   DELETE
   SKIP
  ENDDO
  SELECT 2
 CASE MULTSN=1
  CLOSE DATABASES
  SELECT 2
  USE REPWORK
  SELECT 1
  USE &DBNAME INDEX &INDEX2,&INDEX1
  SEEK TVANO
IF EOF()
 CLEAR
 @ 1,20 SAY 'Data base in use:  '
 ?? OSS
 @ 5,0 SAY 'No record was found in which "'
 ?? TVANO
 ??'" exactly '
 ?'matched any item in the '
 ?? SERIALNUM
 ??' field.'
 ?
 ?
 ?
 WAIT
 RETURN
ENDIF
  DO WHILE TVANO=SERIAL_NO
   SELECT 2
   APPEND BLANK
   REPLACE SUBCATID WITH A->SUBCATID
   REPLACE INST_TYPE WITH A->INST_TYPE
   REPLACE TVA_NO WITH A->TVA_NO
   REPLACE SERIAL_NO WITH A->SERIAL_NO
   REPLACE BY_DATE WITH A->BY_DATE
   REPLACE CALIB_DATE WITH A->CALIB_DATE
   REPLACE CAL_DUE_DT WITH A->CAL_DUE_DT
   REPLACE LOCATION WITH A->LOCATION
   REPLACE REMARK WITH A->REMARK
   REPLACE CALIB_INT WITH A->CALIB_INT
   REPLACE LAST_UPDAT WITH A->LAST_UPDAT
   SELECT 1
   DELETE
   SKIP
  ENDDO
  SELECT 2
CASE MULTTV=0.AND.MULTSN=0
DO CASE
 CASE OTHERCAL=1
  SET FILTER TO CALIB_INT=0.OR.CAT3ABB $ SUBCATID
    GO TOP
    COPY TO REPWORK
  DELETE FOR CALIB_INT=0.OR.CAT3ABB $ SUBCATID
 CASE STORAGE=1
  SET FILTER TO SUB1ABB $ SUBCATID
    GO TOP
    COPY TO REPWORK
  DELETE FOR SUB1ABB $ SUBCATID
 CASE CAL=1
  SET FILTER TO SUB2ABB $ SUBCATID.OR.SUB3ABB $ SUBCATID
    GO TOP
    COPY TO REPWORK
  DELETE FOR SUB2ABB $ SUBCATID.OR.SUB3ABB $ SUBCATID
 CASE ALL=1
    COPY TO REPWORK
    DELETE ALL
 CASE CALDU=1
  SET FILTER TO COMPDATE1<=CAL_DUE_DT .AND. COMPDATE2>=CAL_DUE_DT
  GO TOP
  COPY TO REPWORK
  DELETE FOR COMPDATE1<=CAL_DUE_DT .AND. COMPDATE2>=CAL_DUE_DT
 CASE CALDT=1
  SET FILTER TO COMPDATE1<=CALIB_DATE .AND. COMPDATE2>=CALIB_DATE
  GO TOP
  COPY TO REPWORK
  DELETE FOR COMPDATE1<=CALIB_DATE .AND. COMPDATE2>=CALIB_DATE
 CASE CALINT=1
  SET FILTER TO INTERVAL1<=CALIB_INT .AND. INTERVAL2>=CALIB_INT
  GO TOP
  COPY TO REPWORK
  DELETE FOR INTERVAL1<=CALIB_INT .AND. INTERVAL2>=CALIB_INT
 CASE REMK=1
  SET FILTER TO REMARK1 $ REMARK
  GO TOP
  COPY TO REPWORK
  DELETE FOR REMARK1 $ REMARK
 CASE UPDT=1
  SET FILTER TO COMPDATE1<=LAST_UPDAT .AND. COMPDATE2>=LAST_UPDAT
  GO TOP
  COPY TO REPWORK
  DELETE FOR COMPDATE1<=LAST_UPDAT .AND. COMPDATE2>=LAST_UPDAT
 CASE INCAL=1
  SET FILTER TO SUB2ABB $ SUBCATID
    GO TOP
    COPY TO REPWORK
  DELETE FOR SUB2ABB $ SUBCATID
 CASE INREP=1
  SET FILTER TO SUB3ABB $ SUBCATID
    GO TOP
    COPY TO REPWORK
  DELETE FOR SUB3ABB $ SUBCATID
 CASE SERPHRASE=1
  SET FILTER TO SERPH $ SERIAL_NO
  GO TOP
  COPY TO REPWORK
  DELETE FOR SERPH $ SERIAL_NO
 CASE TVAPHRASE=1
  SET FILTER TO TVAPH $ TVA_NO
  GO TOP
  COPY TO REPWORK
  DELETE FOR TVAPH $ TVA_NO
 CASE NOTUSED=1
 DO CASE
  CASE NUMCOND=1
  DO CASE
   CASE COND1=DUEWITHIN.OR. COND1='ONLY'
    SET FILTER TO CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR CALIB_INT=99
   CASE COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.CALIB_INT=99
   CASE COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE).AND.CALIB_INT=99
  ENDCASE
 CASE NUMCOND=2
  DO CASE
   CASE COND1=DUEWITHIN.AND.COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.CALIB_INT=99
   CASE COND1=DUEWITHIN.AND.COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE).AND.CALIB_INT=99
   CASE COND2=LOCATI.AND.COND3=INSTTYPE
    SET FILTER TO LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.CALIB_INT=99
  ENDCASE
 CASE NUMCOND=3
  SET FILTER TO LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.CALIB_INT=99
    GO TOP
    COPY TO REPWORK
  DELETE FOR LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.CALIB_INT=99
ENDCASE
 CASE INACTIVE=0
DO CASE
 CASE NUMCOND=1
  DO CASE
   CASE COND1='ONLY'
    SET FILTER TO BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR BY_DATE>10
   CASE COND1=DUEWITHIN
    SET FILTER TO BYDATE>BY_DATE.AND.BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR BYDATE>BY_DATE.AND.BY_DATE>10
   CASE COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION).AND.BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.BY_DATE>10
   CASE COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE).AND.BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE).AND.BY_DATE>10
  ENDCASE
 CASE NUMCOND=2
  DO CASE
   CASE COND1=DUEWITHIN.AND.COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION).AND.BYDATE>BY_DATE.AND.;
BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.BYDATE>BY_DATE.AND.;
BY_DATE>10
   CASE COND1=DUEWITHIN.AND.COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE).AND.BYDATE>BY_DATE.AND.;
BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE).AND.BYDATE>BY_DATE.AND.;
BY_DATE>10
   CASE COND2=LOCATI.AND.COND3=INSTTYPE
    SET FILTER TO LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.BY_DATE>10
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.BY_DATE>10
  ENDCASE
 CASE NUMCOND=3
  SET FILTER TO LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.BYDATE>BY_DATE.AND.BY_DATE>10
    GO TOP
    COPY TO REPWORK
  DELETE FOR LOC $ UPPER(LOCATION).AND.INST $ ;
UPPER(INST_TYPE).AND.BYDATE>BY_DATE.AND.BY_DATE>10
ENDCASE
 CASE NUMCOND=1
  DO CASE
   CASE COND1=DUEWITHIN
    SET FILTER TO BYDATE>BY_DATE.AND.CALIB_INT#0
    GO TOP
    COPY TO REPWORK
    DELETE FOR BYDATE>BY_DATE.AND.CALIB_INT#0
   CASE COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION)
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION)
   CASE COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE)
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE)
  ENDCASE
 CASE NUMCOND=2
  DO CASE
   CASE COND1=DUEWITHIN.AND.COND2=LOCATI
    SET FILTER TO LOC $ UPPER(LOCATION) .AND. BYDATE>BY_DATE.AND.;
CALIB_INT#0
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION) .AND. BYDATE>BY_DATE.AND.CALIB_INT#0
   CASE COND1=DUEWITHIN.AND.COND3=INSTTYPE
    SET FILTER TO INST $ UPPER(INST_TYPE) .AND. BYDATE>BY_DATE.AND.;
CALIB_INT#0
    GO TOP
    COPY TO REPWORK
    DELETE FOR INST $ UPPER(INST_TYPE) .AND. BYDATE>BY_DATE.AND.CALIB_INT#0
   CASE COND2=LOCATI.AND.COND3=INSTTYPE
    SET FILTER TO LOC $ UPPER(LOCATION) .AND. INST $ UPPER(INST_TYPE)
    GO TOP
    COPY TO REPWORK
    DELETE FOR LOC $ UPPER(LOCATION) .AND. INST $ UPPER(INST_TYPE)
  ENDCASE
 CASE NUMCOND=3
  SET FILTER TO LOC $ UPPER(LOCATION) .AND. INST $ ;
UPPER(INST_TYPE) .AND.BYDATE>BY_DATE.AND.CALIB_INT#0
    GO TOP
    COPY TO REPWORK
  DELETE FOR LOC $ UPPER(LOCATION) .AND. INST $ ;
UPPER(INST_TYPE) .AND.BYDATE>BY_DATE.AND.CALIB_INT#0
ENDCASE
SELECT 2
USE REPDUP INDEX REPDNX
APPEND FROM REPWORK
USE REPWORK
SET BELL OFF
CLEAR
X=0
IF EOF()
 @ 2,15 SAY 'CONDITIONS:'
 ?
 ?
 ?
 IF COND1=DUEWITHIN
  ??DUEDATE
  ??' <= '
  ?? COMPDATE
  ??'   '
 ENDIF
 IF COND3=INSTTYPE
  ?? INSTNAME
  ??':  '
  ?? INST
  ??'   '
 ENDIF
IF NUMCOND=3
 IF COND2=LOCATI
  ? LOCATNAME
  ??':  '
  ?? LOC
 ENDIF
ELSE
 IF COND2=LOCATI
  ?? LOCATNAME
  ??':  '
  ?? LOC
 ENDIF
ENDIF
 ?
 ?
?
  DO CASE
   CASE OTHERCAL=1
    ??'Category:  '
    ?? CATEGORY3
    ??'.'
   CASE STORAGE=1
    ??'Subcategory:  '
    ?? SUBCAT1
    ??'.'
   CASE CAL=1
    ??'Subcategories:  '
    ?? SUBCAT2
    ??' or '
    ?? SUBCAT3
    ??'.'
   CASE ALL=1
    ??'All records in this data base.'
    CASE CALDU=1
    ??'Records with '
    ?? DUEDATE
    ??' designations from '
    ?? COMPDATE1
    ??' to '
    ?? COMPDATE2
    ??'.'
   CASE CALDT=1
    ??'Records with '
    ?? CALIBDATE
    ??' designations from '
    ?? COMPDATE1
    ??' to '
    ?? COMPDATE2
   CASE CALINT=1
    ??'Records with '
    ?? CALINTERVL
    ??' designations from '
    ?? INTERVAL1
    ??' months to'
    ?? INTERVAL2
    ??' months.'
   CASE REMK=1
    ??'Records with the phrase "'
    ?? REMARK1
    ??'" in the '
    ?? REMARKNM
    ??' field.'
   CASE UPDT=1
    ??'Records which were last updated from '
    ?? COMPDATE1
    ??' to '
    ?? COMPDATE2
    ??'.'
   CASE INCAL=1
    ??'Records in subcategory:  '
    ?? SUBCAT2
    ??'.'
   CASE INREP=1
    ??'Records in subcategory:  '
    ?? SUBCAT3
    ??'.'
   CASE SERPHRASE=1
    ??'Records having the phrase "'
    ?? SERPH
    ?? '" in the '
    ?? SERIALNUM
    ??' field.'
   CASE TVAPHRASE=1
    ??'Records having the phrase "'
    ?? TVAPH
    ?? '" in the '
    ?? TVANUMBER
    ??' field.'
  CASE NOTUSED=1
    ??'Category '
    ?? CATEGORY2
    ??' ONLY.'
   CASE INACTIVE=0
    ??'Category '
    ?? CATEGORY1
    ??' ONLY.'
   CASE INACTIVE=1
    IF COND1=DUEWITHIN
    ?'Categories:  '
    ?? CATEGORY1
    ??' and '
    ?? CATEGORY2
    ??'.'
    ELSE
    ?'Categories:  '
    ?? CATEGORY1
    ??', '
    ?? CATEGORY2
    ??','
    ?' and '
    ?? CATEGORY3
    ??'.'
    ENDIF
  ENDCASE
 ?
 ?
 ?'      No records satisfying the above condition(s) were found.'
 ?
 ?
 WAIT
 RETURN
ENDIF
ENDCASE
RESPONSE='K'
DO WHILE RECCOUNT()>100 .AND. RESPONSE#'A' .AND. RESPONSE#'B'
  CLEAR
  @ 1,15 SAY 'Data base in use:  '
  ?? OSS
  @ 3,0 SAY 'The total number of records in this modification is'
  ?? RECCOUNT()
  ??'.'
  ?
  ?
  ?'You may either continue with this procedure and process these records or'
  ?'you may abort this procedure and return to the previous menu.'
  ?
  ?
  ?'        A)  Continue this procedure.'
  ?
  ?
  ?'        B)  Abort this procedure and return to the previous menu.'
  ?
  WAIT '                       ' TO RESPONSE
  RESPONSE=UPPER(RESPONSE)
  DO CASE
    CASE RESPONSE='A'
      EXIT
    CASE RESPONSE='B'
      USE
      SELECT 1
      @ ROW()+2,27 SAY 'Rebuilding index files . . .'
      PACK
      @ ROW()+2,21 SAY 'Restoring records to main data base . . .'
      APPEND FROM REPWORK
      SELECT 2
      USE REPWORK
      ZAP
      USE REPDUP INDEX REPDNX
      ZAP
      SELECT 1
      RETURN
  ENDCASE
ENDDO
ORDERTMP='Z'
ORDERTEMP='Z'
DO WHILE ASC(ORDERTMP)<ASC('A').OR.ASC(ORDERTMP)>ASC('I')
CLEAR
@ 1,0 SAY 'You may order the records according to the contents of any of the'
?'fields listed below.  Choose any one of them, or you may press RETURN to'
?'return to a previous menu.'
?
?'          A)  '
?? INSTNAME
?
IF MULTSN=1
  ?'   (fast) B)  '
  ?? SERIALNUM
 ELSE
  ?'          B)  '
  ?? SERIALNUM
ENDIF
?
IF MULTSN#1
  ?'   (fast) C)  '
  ?? TVANUMBER
 ELSE
  ?'          C)  '
  ?? TVANUMBER
ENDIF
?
?'          D)  '
?? CALIBDATE
?
?'          E)  '
?? DUEDATE
?
?'          F)  '
?? LOCATNAME
?
?'          G)  '
?? CALINTERVL
?
?'          H)  Last Update'
?
?'          I)  '
?? REMARKNM
?
WAIT '            ' TO ORDERTMP
ORDERTMP=UPPER(LTRIM(TRIM(ORDERTMP)))
@ ROW(),12 SAY 'WORKING . . .                       '
IF LEN(ORDERTMP)=0
  CLOSE DATABASES
  USE &DBNAME INDEX &INDEX1,&INDEX2
  CLEAR
  @ 5,27 SAY 'Rebuilding index files . . .'
  PACK
  @ 8,21 SAY 'Restoring records to main data base . . .'
  APPEND FROM REPWORK
  USE REPDUP INDEX REPDNX
  ZAP
  USE REPWORK
  ZAP
  USE &DBNAME INDEX &INDEX1,&INDEX2
  RETURN
ENDIF
ENDDO
DO CASE
  CASE ORDERTMP='A'
   ORDERTEMP='INST_TYPE'
  CASE ORDERTMP='F'
   ORDERTEMP='LOCATION'
  CASE ORDERTMP='G'
   ORDERTEMP='CALIB_INT'
  CASE ORDERTMP='I'
   ORDERTEMP='REMARK'
ENDCASE
DO CASE
  CASE ORDERTMP='B'
   IF MULTSN#1
    INDEX ON SERIAL_NO TO TMPNDX
    SET INDEX TO TMPNDX
   ELSE
   DUP100=1
   ENDIF
  CASE ORDERTMP='C'
   IF MULTSN=1
    INDEX ON TVA_NO TO TMPNDX
    SET INDEX TO TMPNDX
   ELSE
    DUP100=1
   ENDIF
  CASE ORDERTMP='D'
   INDEX ON STR(YEAR(CALIB_DATE),4)+DTOC(CALIB_DATE) TO TMPNDX
   SET INDEX TO TMPNDX
  CASE ORDERTMP='E'
   INDEX ON STR(YEAR(CAL_DUE_DT),4)+DTOC(CAL_DUE_DT) TO TMPNDX
   SET INDEX TO TMPNDX
  CASE ORDERTMP='H'
   INDEX ON STR(YEAR(LAST_UPDAT),4)+DTOC(LAST_UPDAT) TO TMPNDX
   SET INDEX TO TMPNDX
  OTHERWISE
   INDEX ON &ORDERTEMP TO TMPNDX
   SET INDEX TO TMPNDX
ENDCASE
IF DUP100=0
COPY TO REPDUP1
USE REPDUP1
COPY TO REPWORK
ZAP
USE REPWORK
ENDIF
N4='Y'
TOTALREC=RECCOUNT()
GO TOP
IF DUPREC='N'
SET FORMAT TO REPMODIN.FMT
ELSE
SET FORMAT TO REPMODY.FMT
ENDIF
DO WHILE N4='Y'
 EDIT
 N4='K'
 DO WHILE N4#'Y'.AND.N4#'N'
  CLEAR
  ?
  ?
  ?
  ?
  ?
  WAIT '      Do you wish to make any more changes to these records ?;
  (Y/N)' TO N4
  N4=UPPER(N4)
  IF N4#'Y'.AND.N4#'N'
   LOOP
  ENDIF
 ENDDO
ENDDO
  ERRFILE=0
  CHECKDT=1
  CHECKDATE='K'
 DO WHILE CHECKDATE#'N' .AND. CHECKDATE#'Y'
   CLEAR
   @ 5,7 SAY 'Do you wish to make any corrections during the record checking'
   @ 6,7 SAY 'procedure if any errors are found ? (Y/N)'
   @ 10,7 SAY 'If not, it will be necessary to make the corrections after the'
   WAIT '       record check is complete.' TO CHECKDATE
   CHECKDATE=UPPER(CHECKDATE)
   IF CHECKDATE='N'
    CHECKDT=0
   ENDIF
  ENDDO
   CLEAR
   @ 1,16 SAY 'Data base in use:  '
   ?? OSS
   @ 3,0
  ?'The record modifications are now being processed, and checked.  If they are'
   ?'okay, they will automatically be added to the main data base.'
   ?
   ?
   ?
   ?
   ?'                           ONE MOMENT PLEASE'
   ?
   ?'                ________________________________________'
   ?'               |                                        |'
   ?'               |    PLEASE DO NOT PRESS ANY KEYS YET    |'
   ?'               |________________________________________|'
   ?
   ?
   @ 0,16 SAY 'Working on preliminary record check.'
   DELETE FOR LEN(TRIM(INST_TYPE))=0
   SET DELETED OFF
   COPY TO REPDEL FOR DELETED()
   SET DELETED ON
   PACK
   YR=YEAR(DAT)
   MO=MONTH(DAT)
   DY=DAY(DAT)
   MODREC=RECCOUNT()
   @ 0,3 SAY 'Total No. of records (after any deletions) in this ;
modification is'
   ?? MODREC
   ??'.'
   @ 2,3 SAY 'Total No. of records which were deleted is'
   RECDEL=TOTALREC-MODREC
   ?? RECDEL
   ??'.'
   GO TOP
   @ 23,24 SAY 'Now checking record'
   @ 23,43 SAY RECNO()
   SELECT 4
   USE REPERR
   SELECT 2
   DO WHILE .NOT. EOF()
    REPLACE LAST_UPDATE WITH DAT
    REPLACE INST_TYPE WITH LTRIM(INST_TYPE)
    REPLACE SUBCATID WITH LTRIM(UPPER(SUBCATID))
    REPLACE SERIAL_NO WITH UPPER(LTRIM(SERIAL_NO))
    REPLACE TVA_NO WITH UPPER(LTRIM(TVA_NO))
    IF TVAID='Y'
     IF ' ' $ TRIM(TVA_NO)
       VSTR=TRIM(TVA_NO)
       DO WHILE ' ' $ VSTR
         P=AT(' ',VSTR)
         VSTR=LEFT(VSTR,P-1)+RIGHT(VSTR,LEN(VSTR)-P)
       ENDDO
       REPLACE TVA_NO WITH VSTR
     ENDIF
    ENDIF
    IF SERID='Y'
     IF ' ' $ TRIM(SERIAL_NO)
       VSTR=TRIM(SERIAL_NO)
       DO WHILE ' ' $ VSTR
         P=AT(' ',VSTR)
         VSTR=LEFT(VSTR,P-1)+RIGHT(VSTR,LEN(VSTR)-P)
       ENDDO
       REPLACE SERIAL_NO WITH VSTR
     ENDIF
    ENDIF
    CVAR=LTRIM(TRIM(UPPER(COMLINE)))
    IF '.D.' $ CVAR.OR.'.E.' $ CVAR
     REPLACE REMARK WITH ' '
     IF LEN(CVAR)<4
      CVAR=' '
     ENDIF
    ENDIF
    IF '.' $ CVAR
     IF '2' $ CVAR
      REPLACE CALIB_INT WITH 99
      REPLACE BY_DATE WITH 0
      IF '.ED.' $ CVAR.OR.'.DD.' $ CVAR
       REPLACE CALIB_DATE WITH CTOD('  /  /  ')
       REPLACE CAL_DUE_DT WITH CALIB_DATE
      ENDIF
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
     ENDIF
     IF '3' $ CVAR
      REPLACE CALIB_INT WITH 0
      REPLACE BY_DATE WITH 0
      IF '.ED.' $ CVAR.OR.'.DD.' $ CVAR
       REPLACE CALIB_DATE WITH CTOD('  /  /  ')
       REPLACE CAL_DUE_DT WITH CALIB_DATE
      ENDIF
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
     ENDIF
    DO CASE
     CASE '.OF.' $ CVAR.OR.'.0F.' $ CVAR
      CALOVER=0
      REPLACE BY_DATE WITH CALOVER
     CASE '.PO.' $ CVAR
      CALOVER=200
      REPLACE BY_DATE WITH CALOVER
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
     CASE '.P0.' $ CVAR
      CALOVER=200
      REPLACE BY_DATE WITH CALOVER
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
     CASE '.O.' $ CVAR
      CALOVER=100
      REPLACE BY_DATE WITH CALOVER
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
     CASE '.0.' $ CVAR
      CALOVER=100
      REPLACE BY_DATE WITH CALOVER
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
    ENDCASE
    IF ('.ED.' $ CVAR.OR.'.DD.' $ CVAR).AND.(CALIB_INT=0.OR.CALIB_INT=99)
      REPLACE CALIB_DATE WITH CTOD('  /  /  ')
      REPLACE CAL_DUE_DT WITH CALIB_DATE
      REPLACE BY_DATE WITH 0
      REPLACE COMLINE WITH ' '
      SKIP
      @ 23,43 SAY RECNO()
      LOOP
    ENDIF
    ENDIF
    IF CALIB_INT=99 .OR. CALIB_INT=0
      REPLACE BY_DATE WITH 0
      REPLACE COMLINE WITH ' '
     SKIP
     @ 23,43 SAY RECNO()
     LOOP
    ENDIF
  REPLACE COMLINE WITH ' '
  IF YEAR(CALIB_DATE)+100-YEAR(DAT)<10
   MOCALDT=MONTH(CALIB_DATE)
   DYCALDT=DAY(CALIB_DATE)
   YRCALDT=INT(YEAR(CALIB_DATE)+100)
   IF MOCALDT<10
     M=1
    ELSE
     M=2
   ENDIF
   IF DYCALDT<10
     D=1
    ELSE
     D=2
   ENDIF
   REPLACE CALIB_DATE WITH CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+;
STR(YRCALDT,4,0))
  ENDIF
  IF YEAR(CAL_DUE_DT)+100-YEAR(DAT)<10
   MOCALDT=MONTH(CAL_DUE_DT)
   DYCALDT=DAY(CAL_DUE_DT)
   YRCALDT=INT(YEAR(CAL_DUE_DT)+100)
   IF MOCALDT<10
     M=1
    ELSE
     M=2
   ENDIF
   IF DYCALDT<10
     D=1
    ELSE
     D=2
   ENDIF
   REPLACE CAL_DUE_DT WITH CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+;
STR(YRCALDT,4,0))
  ENDIF
  IF BY_DATE#200.AND.CALOVER=0
    TCOMP=YR*365.24+MO*30.44+DY
    TDCOMP=YR*365.24+(MO-CALIB_INT)*30.44+DY
    CDCOMP=YEAR(CALIB_DATE)*365.24+MONTH(CALIB_DATE)*30.44+DAY(CALIB_DATE)
    CALDUEP=CDCOMP+CALIB_INT*30.44-5
    CALDUDT=YEAR(CAL_DUE_DT)*365.24+MONTH(CAL_DUE_DT)*30.44+DAY(CAL_DUE_DT)
    IF TDCOMP>CDCOMP.OR.CDCOMP>TCOMP
    IF CHECKDT=0
     ERRFILE=1
     SELECT 4
     APPEND BLANK
     REPLACE SUBCATID WITH B->SUBCATID
     REPLACE INST_TYPE WITH B->INST_TYPE
     REPLACE TVA_NO WITH B->TVA_NO
     REPLACE SERIAL_NO WITH B->SERIAL_NO
     REPLACE BY_DATE WITH B->BY_DATE
     REPLACE CALIB_DATE WITH B->CALIB_DATE
     REPLACE CAL_DUE_DT WITH B->CAL_DUE_DT
     REPLACE LOCATION WITH B->LOCATION
     REPLACE REMARK WITH B->REMARK
     REPLACE CALIB_INT WITH B->CALIB_INT
     REPLACE LAST_UPDAT WITH B->LAST_UPDAT
     SELECT 2
     DELETE
     SKIP
     LOOP
    ENDIF
     DO REPCALDT
     @ 23,24 SAY 'Now checking record'
     @ 23,43 SAY RECNO()
     LOOP
    ENDIF
    YRDUE=YEAR(CALIB_DATE)
    MODUE=MONTH(CALIB_DATE)+CALIB_INT
    DYDUE=DAY(CALIB_DATE)
    IF MODUE>12
     YRDUE=YRDUE+INT(MODUE/12)
     MODUE=INT(MODUE-INT(MODUE/12)*12)
    ENDIF
    M=1
    IF MODUE>9
     M=2
    ENDIF
    D=2
    IF DYDUE<10
     D=1
    ENDIF
    DATDU=STR(MODUE,M,0)+'/'+STR(DYDUE,D,0)+'/'+STR(YRDUE,4,0)
    CALCDUDT=CTOD(DATDU)
    CALDUETY=YEAR(CALCDUDT)*365.24+MONTH(CALCDUDT)*30.44+DAY(CALCDUDT)
    IF CALDUDT>CALDUETY.OR.CALDUDT<CALDUEP
    IF CHECKDT=0
     ERRFILE=1
     SELECT 4
     APPEND BLANK
     REPLACE SUBCATID WITH B->SUBCATID
     REPLACE INST_TYPE WITH B->INST_TYPE
     REPLACE TVA_NO WITH B->TVA_NO
     REPLACE SERIAL_NO WITH B->SERIAL_NO
     REPLACE BY_DATE WITH B->BY_DATE
     REPLACE CALIB_DATE WITH B->CALIB_DATE
     REPLACE CAL_DUE_DT WITH B->CAL_DUE_DT
     REPLACE LOCATION WITH B->LOCATION
     REPLACE REMARK WITH B->REMARK
     REPLACE CALIB_INT WITH B->CALIB_INT
     REPLACE LAST_UPDAT WITH B->LAST_UPDAT
     SELECT 2
     DELETE
     SKIP
     LOOP
    ENDIF
     DO REPCALDU
     @ 23,24 SAY 'Now checking record'
     @ 23,43 SAY RECNO()
    LOOP
    ENDIF
   IF BY_DATE#200
    REPLACE BY_DATE WITH CALDUDT-1
   ENDIF
  ENDIF
    SKIP
    CALOVER=0
    @ 23,43 SAY RECNO()
   ENDDO
   IF ERRFILE=1
    SELECT 4
    GO TOP
    DO ERRFILE
    USE
    SELECT 2
    APPEND FROM REPERR
    PACK
    USE
    SELECT 4
    USE REPERR
    ZAP
    SELECT 2
   ENDIF
   USE
   SELECT 1
   @ 23,6 SAY 'Finished record check.  Now adding record(s) to main data base.'
   APPEND FROM REPWORK
   USE REPWORK
   GO TOP
   IF EOF()
    CLEAR
    @ 7,30 SAY 'RECORD(S) DELETED'
    @ 10,0
    WAIT '                       Press any key to continue. . . ' TO RESPONSE
    MODFILE=1
    PDELREC=1
    ADDFILE=0
    SEECODE='K'
DO WHILE SEECODE#'APPLE'
  CLEAR
  @ 1,10 SAY 'What do you want to do ?'
  @ 4,10 SAY 'A)  Print the record(s) which were just deleted.'
  @ 6,10 SAY 'B)  View the record(s) which were just deleted.'
  @ 8,10 SAY 'C)  Both print and view the record(s) which were just deleted.'
  IF DUPREC='N'
  @ 10,7 SAY '----------------------------------------------------------------;
-----'
  @ 12,10 SAY 'D)  RESTORE all records which were just deleted to the main ;
data base.'
  ENDIF
    ?
    WAIT '          Press "RETURN" to return to a previous menu.' TO SEECODE
   SEECODE=UPPER(SEECODE)
   DO CASE
    CASE SEECODE='A'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      PRINTOUT=1
      VIEW=0
    CASE SEECODE='B'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      VIEW=1
      PRINTOUT=0
    CASE SEECODE='C'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      PRINTOUT=1
      VIEW=1
    CASE SEECODE='D'.AND.RECDEL>0.AND.DUPREC='N'
      CLEAR
     @ 10,10 SAY 'Now restoring all records just deleted to the main data base.'
      @ 16,35 SAY 'WORKING . . .'
      SELECT 2
      USE REPDEL
      SET DELETED OFF
      RECALL ALL
      SET DELETED ON
      GO TOP
      SELECT 3
      USE REPDUP INDEX REPDNX
      GO TOP
      DO WHILE .NOT. EOF()
      SELECT 3
      SEEK B->TVA_NO
      SELECT 2
      REPLACE SUBCATID WITH C->SUBCATID
      REPLACE INST_TYPE WITH C->INST_TYPE
      REPLACE SERIAL_NO WITH C->SERIAL_NO
      REPLACE BY_DATE WITH C->BY_DATE
      REPLACE CALIB_DATE WITH C->CALIB_DATE
      REPLACE CAL_DUE_DT WITH C->CAL_DUE_DT
      REPLACE LOCATION WITH C->LOCATION
      REPLACE REMARK WITH C->REMARK
      REPLACE CALIB_INT WITH C->CALIB_INT
      REPLACE LAST_UPDAT WITH C->LAST_UPDAT
      SKIP
      ENDDO
      SELECT 3
      USE
      RECDEL=0
      SELECT 2
      USE
      SELECT 1
      APPEND FROM REPDEL
      USE &DBNAME INDEX &INDEX1,&INDEX2
      APPEND FROM REPDEL
      USE REPDEL
      ZAP
      USE REPWORK
      ZAP
      USE REPDUP INDEX REPDNX
      ZAP
      RETURN
    CASE ASC(SEECODE)=0
      CLEAR
      @ 10,36 SAY 'WORKING . . .'
      USE REPDEL
      ZAP
      USE REPWORK
      ZAP
      USE REPDUP INDEX REPDNX
      ZAP
      RETURN
    CASE ASC(SEECODE)<65.OR.ASC(SEECODE)>68.OR.RECDEL=0.OR.DUPREC='Y'
      LOOP
  ENDCASE
  IF SEECODE='A'.OR.SEECODE='B'.OR.SEECODE='C'
   SET DELETED OFF
  ENDIF
  DO REPINSTP
  SET DELETED ON
  USE REPWORK
  SEECODE='K'
  LOOP
ENDDO
   USE REPDEL
   ZAP
   USE REPWORK
   ZAP
   USE REPDUP INDEX REPDNX
   ZAP
   RETURN
   ENDIF
MODFILE=1
ADDFILE=0
SEECODE='K'
DO WHILE SEECODE#'APPLE'
  CLEAR
  @ 1,10 SAY 'What do you want to do ?'
  @ 4,10 SAY 'A)  Print the record(s) which you just modified.'
  @ 6,10 SAY 'B)  View the record(s) which you just modified on this screen.'
  @ 8,10 SAY 'C)  Both print and view the record(s) which you just modified.'
  IF RECDEL>0
  @ 10,7 SAY '----------------------------------------------------------------;
-----'
  @ 12,10 SAY 'D)  Print the record(s) which were just deleted.'
  @ 14,10 SAY 'E)  View the record(s) which were just deleted.'
  @ 16,10 SAY 'F)  Both print and view the record(s) which were just deleted.'
  IF DUPREC='N'
  @ 18,7 SAY '----------------------------------------------------------------;
-----'
  @ 20,10 SAY 'G)  RESTORE all records which were just deleted to the main ;
data base.'
  ENDIF
  ENDIF
  ?
WAIT '          Press "RETURN" to return to a previous menu.' TO SEECODE
??'  WORKING . . .'
  SEECODE=UPPER(SEECODE)
  DO CASE
    CASE SEECODE='A'
      PDELREC=0
      PRINTOUT=1
      VIEW=0
    CASE SEECODE='B'
      PDELREC=0
      VIEW=1
      PRINTOUT=0
    CASE SEECODE='C'
      PDELREC=0
      PRINTOUT=1
      VIEW=1
    CASE SEECODE='D'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      PRINTOUT=1
      VIEW=0
    CASE SEECODE='E'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      VIEW=1
      PRINTOUT=0
    CASE SEECODE='F'.AND.RECDEL>0
      PDELREC=1
      USE REPDEL
      PRINTOUT=1
      VIEW=1
    CASE SEECODE='G'.AND.RECDEL>0.AND.DUPREC='N'
      CLEAR
     @ 10,10 SAY 'Now restoring all records just deleted to the main data base.'
      @ 16,35 SAY 'WORKING . . .'
      SELECT 2
      USE REPDEL
      SET DELETED OFF
      RECALL ALL
      SET DELETED ON
      GO TOP
      SELECT 3
      USE REPDUP INDEX REPDNX
      GO TOP
      DO WHILE .NOT. EOF()
      SELECT 3
      SEEK B->TVA_NO
      SELECT 2
      REPLACE SUBCATID WITH C->SUBCATID
      REPLACE INST_TYPE WITH C->INST_TYPE
      REPLACE SERIAL_NO WITH C->SERIAL_NO
      REPLACE BY_DATE WITH C->BY_DATE
      REPLACE CALIB_DATE WITH C->CALIB_DATE
      REPLACE CAL_DUE_DT WITH C->CAL_DUE_DT
      REPLACE LOCATION WITH C->LOCATION
      REPLACE REMARK WITH C->REMARK
      REPLACE CALIB_INT WITH C->CALIB_INT
      REPLACE LAST_UPDAT WITH C->LAST_UPDAT
      SKIP
      ENDDO
      SELECT 3
      USE
      RECDEL=0
      SELECT 2
      USE
      SELECT 1
      APPEND FROM REPDEL
      USE &DBNAME INDEX &INDEX1,&INDEX2
      APPEND FROM REPDEL
      USE REPWORK
      LOOP
    CASE ASC(SEECODE)=0
      CLEAR
      @ 10,36 SAY 'WORKING . . .'
      USE REPDEL
      ZAP
      USE REPWORK
      ZAP
      USE REPDUP INDEX REPDNX
      ZAP
      RETURN
    CASE ASC(SEECODE)<65.OR.ASC(SEECODE)>71.OR.RECDEL=0.OR.DUPREC='Y'
      LOOP
  ENDCASE
  IF SEECODE='D'.OR.SEECODE='E'.OR.SEECODE='F'
   SET DELETED OFF
  ENDIF
  DO REPINSTP
  SET DELETED ON
  USE REPWORK
  SEECODE='K'
  LOOP
ENDDO
   USE REPDEL
   ZAP
   USE REPWORK
   ZAP
   USE REPDUP INDEX REPDNX
   ZAP
   RETURN